﻿Imports Microsoft.VisualBasic.CompilerServices
Imports System
Imports System.Collections
Imports System.Collections.Generic
Imports System.Diagnostics
Imports System.Drawing
Imports System.Runtime.CompilerServices
Imports System.Runtime.InteropServices
Imports System.Text.RegularExpressions
Imports System.Windows.Forms
Imports System.ComponentModel
Imports System.Text


<ToolboxBitmap(GetType(System.Windows.Forms.RichTextBox))> _
Public Class SyntaxRtb
    Inherits RichTextBox
    ' Methods

    Public ToolTip As ToolTip
    Private lastPosition As Point

    Public Property ToolTips As Boolean = False
    Public Property SyntaxColoring As Boolean = False
    Public Property AutoCloseClips As Boolean = False

    Public Sub New()
        Me.UndoArgs = New List(Of UndoRedoArgs)
        Me.RedoArgs = New List(Of UndoRedoArgs)
        Me.UndoRedo = False
        Me.LastText = String.Empty
        Me.tab = ChrW(9)
        Me.Matchings = New List(Of RegexHighlightGroup)

        ToolTip = New ToolTip
        ToolTip.ToolTipIcon = ToolTipIcon.Info
        ToolTip.UseFading = True

        Me.InitializeComponent()
    End Sub



    ''' <summary>
    ''' Ruft das Wort ab, dass der angegebenen Position am nächsten liegt.
    ''' </summary>
    ''' <param name="pt">Die zu suchende Position.</param>
    ''' <returns>Das Wort an der angegebenen Position.</returns>
    ''' <remarks></remarks>
    Public Function GetWordFromPosition(pt As Point) As String
        ' Index des Zeichens unter dem Cursor finden
        Dim currentIndex As Integer = Me.GetCharIndexFromPosition(pt)
        Dim startIndex As Integer = 0
        Dim endIndex As Integer = Me.Text.Length ' 0

        ' Index des ersten Zeichens vom aktuellen Wort finden
        For i As Integer = currentIndex To 0 Step -1
            If Not IsSymbol(Me.Text(i)) Then
                startIndex = i + 1
                Exit For
            End If
        Next

        ' Nothing zurückgeben, wenn Ende erreicht
        If startIndex = Me.TextLength Then Return Nothing

        ' Index des letzten Zeichens vom aktuellen Wort finden
        For i As Integer = startIndex To Me.TextLength - 1
            If Not IsSymbol(Me.Text(i)) Then
                endIndex = i
                Exit For
            End If
        Next

        ' Wort zurückgeben
        Return Me.Text.Substring(startIndex, endIndex - startIndex)
    End Function

    Function IsSymbol(ch As Char)
        If Char.IsLetter(ch) Or Char.IsDigit(ch) Or IsOP(ch) Then
            Return True
        Else
            Return False
        End If
    End Function
    Function IsOP(ch As String)
        Select Case ch
            Case "+", "*", "/", "-", "!", "(", ")", "[", "]", "{", "}", "<", ">", """", ",", ".", "-", "_", _
                "\", "?", "$", "@", "€", "&", "=", "&", ":", ";", "°", "^", "|"

                Return True
            Case Else
                Return False
        End Select
    End Function


    Public Sub ShowToolTipp(title As String, content As String)
        ToolTip.ToolTipTitle = title
        ToolTip.Show(content, Me)
    End Sub


    <DebuggerNonUserCode()> _
    Private Shared Sub _ENCAddToList(ByVal value As Object)
        Dim list As List(Of WeakReference) = SyntaxRtb.__ENCList
        SyncLock list
            If (SyntaxRtb.__ENCList.Count = SyntaxRtb.__ENCList.Capacity) Then
                Dim index As Integer = 0
                Dim num3 As Integer = (SyntaxRtb.__ENCList.Count - 1)
                Dim i As Integer = 0
                Do While (i <= num3)
                    Dim reference As WeakReference = SyntaxRtb.__ENCList.Item(i)
                    If reference.IsAlive Then
                        If (i <> index) Then
                            SyntaxRtb.__ENCList.Item(index) = SyntaxRtb.__ENCList.Item(i)
                        End If
                        index += 1
                    End If
                    i += 1
                Loop
                SyntaxRtb.__ENCList.RemoveRange(index, (SyntaxRtb.__ENCList.Count - index))
                SyntaxRtb.__ENCList.Capacity = SyntaxRtb.__ENCList.Count
            End If
            SyntaxRtb.__ENCList.Add(New WeakReference(RuntimeHelpers.GetObjectValue(value)))
        End SyncLock
    End Sub

    Public Sub AddPattern(ByVal pattern As String, ByVal fontColor As Color, Optional ByVal bold As Boolean = False, Optional ByVal italic As Boolean = False, Optional ByVal underlined As Boolean = False)
        Me.AddPattern(pattern, fontColor, bold, italic, underlined, 0)
    End Sub

    Public Sub AddPattern(ByVal pattern As String, ByVal fontColor As Color, ByVal bold As Boolean, ByVal italic As Boolean, ByVal underlined As Boolean, ByVal group As Integer)
        Dim e As New _Closure With { _
                .Local_Bold = bold, _
                .Local_Underlined = underlined, _
                .Local_Italic = italic _
                }
        Dim item As New RegexHighlightGroup With { _
                .Regex = New Regex(pattern, RegexOptions.Compiled), _
                .Group = group, _
                .Color = fontColor, _
                .Font = New Func(Of Font, Font)(AddressOf e._Lambda) _
                }
        Me.Matchings.Add(item)
        Me.ColorVisibleLines()
    End Sub

    Private Sub BeginUpdate(ByVal ctr As Control)
        Me.updating += 1
        If (Me.updating <= 1) Then
            Me.oldEventMask = SyntaxRtb.SendMessage(ctr.Handle, &H431, 0, 0)
            SyntaxRtb.SendMessage(ctr.Handle, 11, 0, 0)
        End If
    End Sub

    Private Sub CloseTag()
        Dim enumerator As IEnumerator = Nothing
        Dim regex As New Regex("<\w+((\s+\w+(\s*=\s*(?:"".*?""|'.*?'|[^'"">\s]+))?)+\s*|\s*)>")
        Dim match As Match = Nothing
        Try
            enumerator = regex.Matches(Me.Text).GetEnumerator
            Do While enumerator.MoveNext
                Dim current As Match = DirectCast(enumerator.Current, Match)
                If ((current.Index + current.Length) = Me.SelectionStart) Then
                    match = current
                    GoTo Label_0085
                End If
            Loop
        Finally
            If TypeOf enumerator Is IDisposable Then
                TryCast(enumerator, IDisposable).Dispose()
            End If
        End Try
Label_0085:
        If (Not match Is Nothing) Then
            Dim str As String = match.Value.TrimStart(New Char() {"<"c, "/"c}).TrimEnd(New Char() {">"c, "/"c})
            Dim index As Integer = str.IndexOf(" ")
            If (index <> -1) Then
                str = str.Substring(0, index)
            End If
            Dim selectionStart As Integer = Me.SelectionStart
            Me.Text = Me.Text.Insert(Me.SelectionStart, ("</" & str & ">"))
            Me.SelectionStart = selectionStart
        End If
    End Sub

    Private Sub ColorLine(ByVal lineIndex As Integer)
        Me.BeginUpdate(Me)
        Dim firstCharIndex As Integer = Me.GetFirstCharIndex(lineIndex)
        Dim input As String = Me.Lines(lineIndex).Replace(Convert.ToString(Me.tab), " ")
        Dim strArray As String() = input.Split(New Char() {Convert.ToChar(" ")})
        Dim num4 As Integer = firstCharIndex
        Dim selectionStart As Integer = Me.SelectionStart
        Dim selectionLength As Integer = Me.SelectionLength
        Dim arg As Font = Me.Font
        Dim foreColor As Color = Me.ForeColor
        Me.SelectionStart = firstCharIndex
        Me.SelectionLength = input.Length
        Me.SelectionFont = arg
        Me.SelectionColor = foreColor
        Dim group As RegexHighlightGroup
        For Each group In Me.Matchings
            Dim enumerator As IEnumerator = Nothing
            Dim matchs As MatchCollection = group.Regex.Matches(input)
            Try
                enumerator = matchs.GetEnumerator
                Do While enumerator.MoveNext
                    Dim current As Match = DirectCast(enumerator.Current, Match)
                    Dim group2 As Group = current.Groups.Item(group.Group)
                    Me.SelectionStart = (firstCharIndex + current.Index)
                    Me.SelectionLength = group2.Length
                    Me.SelectionFont = group.Font.Invoke(arg)
                    Me.SelectionColor = group.Color
                Loop
            Finally
                If TypeOf enumerator Is IDisposable Then
                    TryCast(enumerator, IDisposable).Dispose()
                End If
            End Try
        Next
        Me.SelectionStart = selectionStart
        Me.SelectionLength = selectionLength
        Me.SelectionFont = arg
        Me.SelectionColor = foreColor
        Me.EndUpdate(Me)
    End Sub

    Private Sub ColorRtb()
        Dim num2 As Integer = (Me.Lines.Length - 1)
        Dim i As Integer = 0
        Do While (i <= num2)
            Me.ColorLine(i)
            i += 1
        Loop
    End Sub

    Private Sub ColorVisibleLines()
        Dim firstVisibleLine As Integer = Me.FirstVisibleLine
        Dim lastVisibleLine As Integer = Me.LastVisibleLine
        If ((firstVisibleLine >= 0) AndAlso (lastVisibleLine >= 0)) Then
            Dim num4 As Integer = (lastVisibleLine - 1)
            Dim i As Integer = firstVisibleLine
            Do While (i <= num4)
                Me.ColorLine(i)
                i += 1
            Loop
        End If
    End Sub

    Public Overloads Sub Copy()
        Clipboard.SetText(Me.SelectedText)
    End Sub

    Private Sub EndUpdate(ByVal ctr As Control)
        Me.updating -= 1
        If (Me.updating <= 0) Then
            SyntaxRtb.SendMessage(ctr.Handle, 11, 1, 0)
            SyntaxRtb.SendMessage(ctr.Handle, &H431, 0, Me.oldEventMask)
            ctr.Invalidate()
        End If
    End Sub

    Private Function GetFirstCharIndex(ByVal lineIndex As Integer) As Integer
        Return SyntaxRtb.SendMessage(Me.Handle, Convert.ToInt32(&HBB), lineIndex, 0)
    End Function

    Private Sub InitializeComponent()
        Me.SuspendLayout()
        Me.AcceptsTab = True
        Me.BackColor = Color.FromArgb(&HFF, &HFF, &HE1)
        Me.EnableAutoDragDrop = True
        Me.Font = New Font("Courier New", 9.75!, FontStyle.Regular, GraphicsUnit.Point, 0)
        Me.ForeColor = Color.Black
        Me.ResumeLayout(False)
    End Sub

    Protected Overrides Sub OnFontChanged(ByVal e As EventArgs)
        Me.ColorRtb()
        MyBase.OnFontChanged(e)
    End Sub

    Protected Overrides Sub OnForeColorChanged(ByVal e As EventArgs)
        Me.ColorVisibleLines()
        MyBase.OnForeColorChanged(e)
    End Sub

    Public Event OnWordSearching(currentword As String)
    Protected Overrides Sub OnMouseMove(e As System.Windows.Forms.MouseEventArgs)
        Dim currentWord As String = ""
        ' Aktuelles Wort ermitteln
        If ToolTips AndAlso Not Me.Text = "" Then
            currentWord = GetWordFromPosition(e.Location)
        End If

        ' Prüfe, ob die Position geändert wurde
        If Not lastPosition.Equals(e.Location) Then
            ' true -> Wort als ToolTip anzeigen und aktuelle Position speichern
            If currentWord IsNot Nothing Then
                RaiseEvent OnWordSearching(currentWord)
                lastPosition = e.Location
            End If
        End If


        MyBase.OnMouseMove(e)
    End Sub

    Protected Overrides Sub OnKeyDown(ByVal e As KeyEventArgs)
        If Me.ShortcutsEnabled Then
            If (e.Control AndAlso (e.KeyCode = Keys.V)) Then
                Me.Paste()
                e.Handled = True
            End If
            If (e.Control AndAlso (e.KeyCode = Keys.C)) Then
                Me.Copy()
                e.Handled = True
            End If
            If (e.Control AndAlso (e.KeyCode = Keys.Z)) Then
                Me.Undo()
                e.Handled = True
            End If
            If (e.Control AndAlso (e.KeyCode = Keys.Y)) Then
                Me.Redo()
                e.Handled = True
            End If

        End If
        MyBase.OnKeyDown(e)
    End Sub

    Public Sub Ersetzen(ByVal Wort As String, ByVal Bild As Bitmap)
        Dim Index As Integer = Me.Text.IndexOf(Wort)
        Dim bmp As Bitmap = Bild
        Do Until Index = -1
            Me.SelectionStart = Index
            Me.SelectionLength = Wort.Length
            Me.SelectedText = ""
            Clipboard.SetImage(bmp)
            Me.SelectionStart = Index
            Me.Paste()
            Index = Me.Text.IndexOf(Wort, Index + 1)
        Loop
    End Sub

    <DefaultValue(False)> _
    Public Shadows Property DetectUrls() As Boolean
        Get
            Return MyBase.DetectUrls
        End Get
        Set(value As Boolean)
            MyBase.DetectUrls = value
        End Set
    End Property

    ''' <summary>
    ''' Insert a given text as a link into the RichTextBox at the current insert position.
    ''' </summary>
    ''' <param name="text">Text to be inserted</param>
    Public Sub InsertLink(text As String)
        InsertLink(text, Me.SelectionStart)
    End Sub

    ''' <summary>
    ''' Insert a given text at a given position as a link. 
    ''' </summary>
    ''' <param name="text">Text to be inserted</param>
    ''' <param name="position">Insert position</param>
    Public Sub InsertLink(text As String, position As Integer)
        If position < 0 OrElse position > Me.Text.Length Then
            Throw New ArgumentOutOfRangeException("position")
        End If

        Me.SelectionStart = position
        Me.SelectedText = text
        Me.[Select](position, text.Length)
        Me.SetSelectionLink(True)
        Me.[Select](position + text.Length, 0)
    End Sub

    ''' <summary>
    ''' Insert a given text at at the current input position as a link.
    ''' The link text is followed by a hash (#) and the given hyperlink text, both of
    ''' them invisible.
    ''' When clicked on, the whole link text and hyperlink string are given in the
    ''' LinkClickedEventArgs.
    ''' </summary>
    ''' <param name="text">Text to be inserted</param>
    ''' <param name="hyperlink">Invisible hyperlink string to be inserted</param>
    Public Sub InsertLink(text As String, hyperlink As String)
        InsertLink(text, hyperlink, Me.SelectionStart)
    End Sub

    ''' <summary>
    ''' Insert a given text at a given position as a link. The link text is followed by
    ''' a hash (#) and the given hyperlink text, both of them invisible.
    ''' When clicked on, the whole link text and hyperlink string are given in the
    ''' LinkClickedEventArgs.
    ''' </summary>
    ''' <param name="text">Text to be inserted</param>
    ''' <param name="hyperlink">Invisible hyperlink string to be inserted</param>
    ''' <param name="position">Insert position</param>
    Public Sub InsertLink(text As String, hyperlink As String, position As Integer)
        If position < 0 OrElse position > Me.Text.Length Then
            Throw New ArgumentOutOfRangeException("position")
        End If

        Me.SelectionStart = position
        Me.SelectedRtf = "{\rtf1\ansi " & text & "\v #" & hyperlink & "\v0}"
        Me.[Select](position, text.Length + hyperlink.Length + 1)
        Me.SetSelectionLink(True)
        Me.[Select](position + text.Length + hyperlink.Length + 1, 0)
    End Sub

    ''' <summary>
    ''' Set the current selection's link style
    ''' </summary>
    ''' <param name="link">true: set link style, false: clear link style</param>
    Public Sub SetSelectionLink(link As Boolean)
        SetSelectionStyle(CFM_LINK, If(link, CFE_LINK, 0))
    End Sub
    ''' <summary>
    ''' Get the link style for the current selection
    ''' </summary>
    ''' <returns>0: link style not set, 1: link style set, -1: mixed</returns>
    Public Function GetSelectionLink() As Integer
        Return GetSelectionStyle(CFM_LINK, CFE_LINK)
    End Function


    Private Sub SetSelectionStyle(mask As UInt32, effect As UInt32)
        Dim cf As New CHARFORMAT2_STRUCT()
        cf.cbSize = Marshal.SizeOf(cf)
        cf.dwMask = mask
        cf.dwEffects = effect

        Dim wpar As New IntPtr(SCF_SELECTION)
        Dim lpar As IntPtr = Marshal.AllocCoTaskMem(Marshal.SizeOf(cf))
        Marshal.StructureToPtr(cf, lpar, False)

        Dim res As IntPtr = SendMessage(Handle, EM_SETCHARFORMAT, wpar, lpar)

        Marshal.FreeCoTaskMem(lpar)
    End Sub


    Private Function GetSelectionStyle(mask As UInt32, effect As UInt32) As Integer
        Dim cf As New CHARFORMAT2_STRUCT()
        cf.cbSize = Marshal.SizeOf(cf)
        cf.szFaceName = New Char(31) {}

        Dim wpar As New IntPtr(SCF_SELECTION)
        Dim lpar As IntPtr = Marshal.AllocCoTaskMem(Marshal.SizeOf(cf))
        Marshal.StructureToPtr(cf, lpar, False)

        Dim res As IntPtr = SendMessage(Handle, EM_GETCHARFORMAT, wpar, lpar)

        cf = DirectCast(Marshal.PtrToStructure(lpar, GetType(CHARFORMAT2_STRUCT)), CHARFORMAT2_STRUCT)

        Dim state As Integer
        ' dwMask holds the information which properties are consistent throughout the selection:
        If (cf.dwMask And mask) = mask Then
            If (cf.dwEffects And effect) = effect Then
                state = 1
            Else
                state = 0
            End If
        Else
            state = -1
        End If

        Marshal.FreeCoTaskMem(lpar)
        Return state
    End Function

#Region "Interop-Defines"
    <StructLayout(LayoutKind.Sequential)> _
    Private Structure CHARFORMAT2_STRUCT
        Public cbSize As UInt32
        Public dwMask As UInt32
        Public dwEffects As UInt32
        Public yHeight As Int32
        Public yOffset As Int32
        Public crTextColor As Int32
        Public bCharSet As Byte
        Public bPitchAndFamily As Byte
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=32)> _
        Public szFaceName As Char()
        Public wWeight As UInt16
        Public sSpacing As UInt16
        Public crBackColor As Integer
        ' Color.ToArgb() -> int
        Public lcid As Integer
        Public dwReserved As Integer
        Public sStyle As Int16
        Public wKerning As Int16
        Public bUnderlineType As Byte
        Public bAnimation As Byte
        Public bRevAuthor As Byte
        Public bReserved1 As Byte
    End Structure

    <DllImport("user32.dll", CharSet:=CharSet.Auto)> _
    Private Shared Function SendMessage(hWnd As IntPtr, msg As Integer, wParam As IntPtr, lParam As IntPtr) As IntPtr
    End Function

    Private Const WM_USER As Integer = &H400
    Private Const EM_GETCHARFORMAT As Integer = WM_USER + 58
    Private Const EM_SETCHARFORMAT As Integer = WM_USER + 68

    Private Const SCF_SELECTION As Integer = &H1
    Private Const SCF_WORD As Integer = &H2
    Private Const SCF_ALL As Integer = &H4

#Region "CHARFORMAT2 Flags"
    Private Const CFE_BOLD As UInt32 = &H1
    Private Const CFE_ITALIC As UInt32 = &H2
    Private Const CFE_UNDERLINE As UInt32 = &H4
    Private Const CFE_STRIKEOUT As UInt32 = &H8
    Private Const CFE_PROTECTED As UInt32 = &H10
    Private Const CFE_LINK As UInt32 = &H20
    Private Const CFE_AUTOCOLOR As UInt32 = &H40000000
    Private Const CFE_SUBSCRIPT As UInt32 = &H10000
    ' Superscript and subscript are 
    Private Const CFE_SUPERSCRIPT As UInt32 = &H20000
    '  mutually exclusive			 

    Private Const CFM_SMALLCAPS As Integer = &H40
    ' (*)	
    Private Const CFM_ALLCAPS As Integer = &H80
    ' Displayed by 3.0	
    Private Const CFM_HIDDEN As Integer = &H100
    ' Hidden by 3.0 
    Private Const CFM_OUTLINE As Integer = &H200
    ' (*)	
    Private Const CFM_SHADOW As Integer = &H400
    ' (*)	
    Private Const CFM_EMBOSS As Integer = &H800
    ' (*)	
    Private Const CFM_IMPRINT As Integer = &H1000
    ' (*)	
    Private Const CFM_DISABLED As Integer = &H2000
    Private Const CFM_REVISED As Integer = &H4000

    Private Const CFM_BACKCOLOR As Integer = &H4000000
    Private Const CFM_LCID As Integer = &H2000000
    Private Const CFM_UNDERLINETYPE As Integer = &H800000
    ' Many displayed by 3.0 
    Private Const CFM_WEIGHT As Integer = &H400000
    Private Const CFM_SPACING As Integer = &H200000
    ' Displayed by 3.0	
    Private Const CFM_KERNING As Integer = &H100000
    ' (*)	
    Private Const CFM_STYLE As Integer = &H80000
    ' (*)	
    Private Const CFM_ANIMATION As Integer = &H40000
    ' (*)	
    Private Const CFM_REVAUTHOR As Integer = &H8000


    Private Const CFM_BOLD As UInt32 = &H1
    Private Const CFM_ITALIC As UInt32 = &H2
    Private Const CFM_UNDERLINE As UInt32 = &H4
    Private Const CFM_STRIKEOUT As UInt32 = &H8
    Private Const CFM_PROTECTED As UInt32 = &H10
    Private Const CFM_LINK As UInt32 = &H20
    Private Const CFM_SIZE As UInt32 = &H80000000UI
    Private Const CFM_COLOR As UInt32 = &H40000000
    Private Const CFM_FACE As UInt32 = &H20000000
    Private Const CFM_OFFSET As UInt32 = &H10000000
    Private Const CFM_CHARSET As UInt32 = &H8000000
    Private Const CFM_SUBSCRIPT As UInt32 = CFE_SUBSCRIPT Or CFE_SUPERSCRIPT
    Private Const CFM_SUPERSCRIPT As UInt32 = CFM_SUBSCRIPT

    Private Const CFU_UNDERLINENONE As Byte = &H0
    Private Const CFU_UNDERLINE As Byte = &H1
    Private Const CFU_UNDERLINEWORD As Byte = &H2
    ' (*) displayed as ordinary underline	
    Private Const CFU_UNDERLINEDOUBLE As Byte = &H3
    ' (*) displayed as ordinary underline	
    Private Const CFU_UNDERLINEDOTTED As Byte = &H4
    Private Const CFU_UNDERLINEDASH As Byte = &H5
    Private Const CFU_UNDERLINEDASHDOT As Byte = &H6
    Private Const CFU_UNDERLINEDASHDOTDOT As Byte = &H7
    Private Const CFU_UNDERLINEWAVE As Byte = &H8
    Private Const CFU_UNDERLINETHICK As Byte = &H9
    Private Const CFU_UNDERLINEHAIRLINE As Byte = &HA
    ' (*) displayed as ordinary underline	

#End Region

#End Region

    Protected Overrides Sub OnKeyPress(ByVal e As KeyPressEventArgs)
        If Me.AutoTaging Then
            If (e.KeyChar = ">"c) Then
                e.Handled = True
                Dim selectionStart As Integer = Me.SelectionStart
                Me.Text = Me.Text.Insert(Me.SelectionStart, ">")
                Me.SelectionStart = (selectionStart + 1)
                Me.CloseTag()
            End If
            MyBase.OnKeyPress(e)
        End If

        If AutoCloseClips Then
            CloseClips(e.KeyChar)
        End If

    End Sub

    Protected Overrides Sub OnSizeChanged(ByVal e As EventArgs)
        Me.ColorVisibleLines()
        MyBase.OnSizeChanged(e)
    End Sub

    Protected Overrides Sub OnTextChanged(ByVal e As EventArgs)
        If Not Me.UndoRedo Then
            Me.RedoArgs.Clear()
            Dim startIndex As Integer = 0
            Dim length As Integer = 0
            Dim text As String = ""
            If (Me.LastText.Length < Me.Text.Length) Then
                length = (Me.Text.Length - Me.LastText.Length)
                startIndex = (Me.SelectionStart - length)
            End If
            If (Me.LastText.Length > Me.Text.Length) Then
                length = (Me.LastText.Length - Me.Text.Length)
                startIndex = Me.SelectionStart
                [text] = Me.LastText.Substring(startIndex, length)
            End If
            Me.UndoArgs.Add(New UndoRedoArgs([text], startIndex, length))
            Me.LastText = Me.Text
        End If
        Me.UndoRedo = False

        If SyntaxColoring Then
            Me.ColorVisibleLines()
        End If

        MyBase.OnTextChanged(e)
    End Sub



    Public Sub FindText(ByVal aText As String, ByVal colors As Color)
        Dim tPos As Integer
        Dim tLen As Integer = aText.Length
        tPos = Me.Text.ToUpper.IndexOf(aText.ToUpper, Me.SelectionStart + 1)
        If tPos > -1 Then
            Me.Select(tPos, tLen)
            Me.SelectionBackColor = colors
            Me.ScrollToCaret()
            Me.Focus()
        Else
            ' MsgBox("'" & aText & "' nicht gefunden!", MsgBoxStyle.Information)
        End If
    End Sub

    Public Sub AddContextMenu()
        ' Kontextmenü mit Ereignishändler erstellen
        Dim oMenu As New ContextMenuStrip
        AddHandler oMenu.Opening, AddressOf ContextMenuOpening

        ' Kontextmenü-Einträge erstellen
        oMenu.Items.Add("Rückgängig").Tag = "Undo"
        oMenu.Items.Add("-")
        oMenu.Items.Add("Ausschneiden").Tag = "Cut"
        oMenu.Items.Add("Kopieren").Tag = "Copy"
        oMenu.Items.Add("Einfügen").Tag = "Paste"
        oMenu.Items.Add("Löschen").Tag = "Del"

        ' Ereignishandler für das ItemClicked-Event zuweisen
        AddHandler oMenu.ItemClicked, AddressOf ContextMenuItemClicked

        ' Kontextmenü dem RichTextBox-Control zuweisen
        Me.ContextMenuStrip = oMenu
    End Sub


    Private Sub ContextMenuItemClicked(ByVal sender As Object, ByVal e As System.Windows.Forms.ToolStripItemClickedEventArgs)

        Dim rtb As RichTextBox = CType(sender.SourceControl, RichTextBox)

        ' ... je nach Auswahl, erforderliche Aktion ausführen
        Select Case e.ClickedItem.Tag
            Case "Undo"
                rtb.Undo()
            Case "Cut"
                rtb.Cut()
            Case "Copy"
                rtb.Copy()
            Case "Paste"
                rtb.Paste()
            Case "Del"
                rtb.SelectedText = ""
        End Select
    End Sub

    Private Sub ContextMenuOpening(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs)

        Dim oMenu As ContextMenuStrip = CType(sender, ContextMenuStrip)
        Dim rtb As RichTextBox = CType(oMenu.SourceControl, RichTextBox)

        oMenu.Items(0).Enabled = rtb.CanUndo
        oMenu.Items(2).Enabled = (rtb.SelectionLength > 0)
        oMenu.Items(3).Enabled = (rtb.SelectionLength > 0)
        oMenu.Items(4).Enabled = (Clipboard.ContainsText())
        oMenu.Items(5).Enabled = (rtb.SelectionLength > 0)
    End Sub

    Public Shadows Sub Paste()
        Me.SelectedText = Clipboard.GetText
    End Sub

    Public Shadows Sub Redo()
        If (Me.RedoArgs.Count <> 0) Then
            Me.UndoRedo = True
            Dim index As Integer = (Me.RedoArgs.Count - 1)
            Dim arg As UndoRedoArgs = Me.RedoArgs.Item(index)
            Me.UnReDo(arg)
            Me.UndoArgs.Add(arg)
            Me.RedoArgs.RemoveAt(index)
        End If
    End Sub

    <DllImport("user32", CharSet:=CharSet.Auto)> _
    Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    End Function

    Public Shadows Sub Undo()
        If (Me.UndoArgs.Count <> 0) Then
            Me.UndoRedo = True
            Dim index As Integer = (Me.UndoArgs.Count - 1)
            Dim arg As UndoRedoArgs = Me.UndoArgs.Item(index)
            Me.UnReDo(arg)
            Me.RedoArgs.Add(arg)
            Me.UndoArgs.RemoveAt(index)
        End If
    End Sub

    Private Sub UnReDo(ByVal arg As UndoRedoArgs)
        Try
            If (arg.Text = "") Then
                Me.SelectionStart = arg.SelectionStart
                Me.SelectionLength = arg.SelectionLength
                arg.Text = Me.SelectedText
                Me.SelectedText = ""
            Else
                Me.SelectionStart = arg.SelectionStart
                Me.SelectedText = arg.Text
                arg.Text = ""
            End If
        Catch exception1 As Exception
            ProjectData.SetProjectError(exception1)
            Dim exception As Exception = exception1
            ProjectData.ClearProjectError()
        End Try
    End Sub


    ' Properties
    Public Property AutoTaging As Boolean
        <DebuggerNonUserCode()> _
        Get
            Return Me._AutoTaging
        End Get
        <DebuggerNonUserCode()> _
        Set(ByVal AutoPropertyValue As Boolean)
            Me._AutoTaging = AutoPropertyValue
        End Set
    End Property

    Private ReadOnly Property FirstVisibleChar As Integer
        Get
            Return Me.GetFirstCharIndex(Me.FirstVisibleLine)
        End Get
    End Property

    Private ReadOnly Property FirstVisibleLine As Integer
        Get
            Return SyntaxRtb.SendMessage(Me.Handle, Convert.ToInt32(&HCE), 0, 0)
        End Get
    End Property

    Private ReadOnly Property LastVisibleLine As Integer
        Get
            Dim num As Integer = (Me.FirstVisibleLine + (Me.ClientSize.Height / Me.Font.Height))
            If ((num > Me.Lines.Length) OrElse (num = 0)) Then
                Return Me.Lines.Length
            End If
            Return num
        End Get
    End Property

    Public Shadows ReadOnly Property Rtf As String
        Get
            Me.ColorRtb()
            Return MyBase.Rtf
        End Get
    End Property


    ' Fields
    '  Private Shared __ENCList As List(Of WeakReference) = New List(Of WeakReference)
    <DebuggerBrowsable(DebuggerBrowsableState.Never), CompilerGenerated()> _
    Private _AutoTaging As Boolean
    Private Const EM_SETEVENTMASK As Integer = &H431
    Private LastText As String
    Private Matchings As List(Of RegexHighlightGroup)
    Private oldEventMask As Integer
    Private RedoArgs As List(Of UndoRedoArgs)
    Private tab As Char
    Private UndoArgs As List(Of UndoRedoArgs)
    Private UndoRedo As Boolean
    Private updating As Integer
    Private Const WM_SETREDRAW As Integer = 11

    ' Nested Types
    <CompilerGenerated()> _
    Friend Class _Closure
        ' Methods
        <DebuggerNonUserCode()> _
        Public Sub New()
        End Sub

        <DebuggerNonUserCode()> _
        Public Sub New(ByVal other As _Closure)
            If (Not other Is Nothing) Then
                Me.Local_Bold = other.Local_Bold
                Me.Local_Underlined = other.Local_Underlined
                Me.Local_Italic = other.Local_Italic
            End If
        End Sub

        <CompilerGenerated()> _
        Public Function _Lambda(ByVal Font As Font) As Font
            Return New Font(Font, ((If(Me.Local_Bold, FontStyle.Bold, FontStyle.Regular) Or If(Me.Local_Underlined, FontStyle.Underline, FontStyle.Regular)) Or If(Me.Local_Italic, FontStyle.Italic, FontStyle.Regular)))
        End Function


        ' Fields
        Public Local_Bold As Boolean
        Public Local_Italic As Boolean
        Public Local_Underlined As Boolean
    End Class

    Private Enum EditMessages
        ' Fields
        CharFromPos = &HD7
        GetFirstVisibleLine = &HCE
        LineFromChar = &HC9
        LineIndex = &HBB
        PosFromChar = &H426
    End Enum

    Private Class RegexHighlightGroup
        ' Fields
        Public Color As Color
        Public Font As Func(Of Font, Font)
        Public Group As Integer
        Public Regex As Regex
    End Class

    Private Class UndoRedoArgs
        ' Methods
        Public Sub New(ByVal [Text] As String, ByVal selStart As Integer, ByVal selLength As Integer)
            Me.Text = [Text]
            Me.SelectionStart = selStart
            Me.SelectionLength = selLength
        End Sub


        ' Fields
        Public SelectionLength As Integer
        Public SelectionStart As Integer
        Public [Text] As String
    End Class



    Private Sub CloseClips(key As String)
        Dim selectionStart As Integer = Me.SelectionStart

        Select Case key
            Case "{"
                Me.Text = Me.Text.Insert(Me.SelectionStart, "}")
            Case "("
                Me.Text = Me.Text.Insert(Me.SelectionStart, ")")
            Case """"
                Me.Text = Me.Text.Insert(Me.SelectionStart, """")
        End Select

        Me.SelectionStart = selectionStart
    End Sub

End Class